home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 1 / PC Actual CD 01.iso / f1 / mdisk25.arj / MDISKPRO.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-09-27  |  12.0 KB  |  392 lines
  1. {$A+,B-,D-,E-,F-,G+,I+,L-,N-,O-,R-,S-,V+,X+}
  2. {$M 16384,0,655360}
  3.  
  4. { MDiskpro (c) Emilio David Diaus 1993,1994 }
  5.  
  6. { Hecho Por Makecode (C) Emilio David Diaus 1993 }
  7. {$Ifndef Ver60 }
  8. Error: Necesario Turbo Pascal 6.0
  9. {$Endif}
  10.  
  11. {
  12. 3. Mdiskpro: MαDulo Principal Del Programa
  13.  
  14. Para La CompilacióN De Este Programa Es Necesario Turbo Pascal
  15. 6.0 O Superior.
  16. En Este Programa Podemos Ver Los Siguientes Objetos:
  17.  
  18.      Tmyapp - Es Un Sucesor De Tapplication En El Que Se Han
  19.      Cambiado Los Siguientes MéTodos:
  20.           Constructor Tmyapp.Init; - Inicializa La Aplicación
  21.           Los Recuadros, Los ParáMetros Y La PresentacióN Del
  22.           Programa.
  23.           Procedure Tmyapp.Getevent - Modificado Para Dar
  24.           Soporte A La Ayuda, AdemáS Obtiene Los Sucesos Del
  25.           Programa.
  26.           Function Tmyapp.Getpalette - Modificado Para Dar Color
  27.           A Las Ventanas De Ayuda.
  28.           Procedure Outofmemory - Modificado Para Mostrar Un
  29.           Mensaje En EspañOl Si Hay AlgúN Problema De Memoria.
  30.           Procedure Handleevent - Maneja Los Sucesos Del
  31.           Programa.
  32.           Procedure Initmenubar - Modificado Para Mostrar La
  33.           Barra De Menú Del Programa.
  34.           Procedure Initstatusline - Modificado Para Mostrar La
  35.           LíNea De Estado.
  36.           Procedure Done - Libera La Memoria Y Devuelve El
  37.           Ordenador Al Estado Anterior Al De Ejecutar El
  38.           Programa.
  39.      Y Se Han AñAdido Los Siguientes TambiéN:
  40.           Change_Drive - Permite Mediante Una Caja De DiáLogo
  41.           Cambiar De Unidad De Disquete, Utiliza Select_Drive.
  42.           Select_Drive - Selecciona Una Unidad De Disquete. 
  43.      AdemáS Se Han AñAdido Las Siguientes Variables:
  44.           Bdrive - Unidad A Procesar.
  45.           Icopies - NúMero De Copias A Realizar.
  46.           Bo_Verify - Bandera De VerificacióN De Las Copias.
  47.      Y Otros Procedimientos Fuera De Tmyapp:
  48.           Change_Window - Cuando Se Está Bajo Os/2 Cambia El
  49.           Nombre De La Ventana Del Programa Y Lo Restaura Al
  50.           Salir.
  51.           Find_Exe_Name - Averigua Desde Que Ruta Se Ejecuta El
  52.           Programa, Vital Para El Sistema De Ayuda.
  53.      Y Otras Variables TambiéN Fuera Del Objeto:
  54.           Comandos Referidos A Acciones Del Usuario Cmxxxx.
  55.           Swhereis - Ruta Donde Está Ubicado El Programa.
  56. Mdiskpro Sigue La Estructura EstáNdar De RealizacióN De Programas
  57. Init, Run Y Done Y El Sistema De Sucesos Similar A Que TendríAmos
  58. Al Programar Para Windows U Otros Sistemas Operativos Como Os/2
  59. O Apple System 7. }
  60. Program Mdiskpro;
  61. Uses Dos,Objects,Drivers,Views,Menus,Dialogs,Emimsbox,Emiapp,Mhelp,Mdhelp,Fonts,
  62.      Mcopy,Opciones,Mdiskerr,Test286,Mtvprot;
  63.  
  64. Const
  65.      Cmcopy     = $100;
  66.      Cmsandc    = $101;
  67.      Cminterr   = $102;
  68.      Cmnothing  = $103;
  69.      Cmopt      = $104;
  70.      Swhere     : String='';
  71.      Scopyright : String=' MicroDisk Pro v 2.5 (c) Emilio David Diaus 1994 ';
  72.  
  73.  
  74. Type
  75.     Tmyapp=Object(Tapplication)
  76.         Bdrive  :    Byte;
  77.         Icopies : Integer;
  78.         Wflags  :    Word;
  79.         Sfile   :  String;
  80.         Constructor Init;
  81.         Destructor Done; Virtual;
  82.  
  83.         Function Select_Drive:Word;
  84.         Function Change_Drive:Word;
  85.         Procedure Change_Window(Sname:String);
  86.         Procedure Writehelp;Virtual;
  87.  
  88.         Procedure Getevent(Var Event: Tevent); Virtual;
  89.         Function Getpalette:Ppalette; Virtual;
  90.         Procedure Outofmemory; Virtual;
  91.         Procedure Handleevent(Var Event: Tevent); Virtual;
  92.         Procedure Initmenubar; Virtual;
  93.         Procedure Initstatusline; Virtual;
  94.         
  95.     End;
  96.  
  97. Type
  98.     Trdialogdata = Record
  99.        Wdrive: Word;
  100.     End;
  101.  
  102. Function Tmyapp.Select_Drive:Word;
  103.  
  104. Var
  105.   Drives_View          :                     Pview;
  106.   Chgdialog            :                   Pdialog;
  107.   Rs                   :                     Trect;
  108.   Wresult              :                      Word;
  109.   Bloop,Bdrives_Found  :                      Byte;
  110.   Sdrive           :                String[11];
  111.   Data                   :              Trdialogdata;
  112.   This_Item,First_Item :                    Psitem;
  113.  
  114. Function Find_Drives(Vfbadaptor:Byte):Word;Assembler;
  115. Asm
  116.    Mov Ah,08h
  117.    Mov Dl,Vfbadaptor
  118.    Int 13h
  119.    Xor Dh,Dh
  120.    Mov Ax,Dx
  121. End;
  122.  
  123. Begin
  124.   Bdrives_Found:=Find_Drives(Opciones_Programa.Adaptador);
  125.   If (Bdrives_Found=1) Then Bdrives_Found:=2;
  126.   If Bdrives_Found>6 Then Bdrives_Found:=6;
  127.   Data.Wdrive:=Opciones_Programa.Unidad;
  128.   If Bdrives_Found<Data.Wdrive Then Bdrives_Found:=Byte(Data.Wdrive)+1;
  129.   Rs.Assign(20, 6, 60, 19);
  130.   Chgdialog := New(Pdialog, Init(Rs, 'Seleccionar unidad'));
  131.   With Chgdialog^ Do
  132.   Begin
  133.     Rs.Assign(13, 4,27,5+Bdrives_Found-1);
  134.     For Bloop:=0 To Bdrives_Found-1 Do Begin
  135.         Sdrive:='Unidad ~'+Chr(Bloop+65)+'~ ';
  136.         If Bloop=0 Then Begin
  137.            This_Item:=Newsitem(Sdrive,Nil);
  138.            First_Item:=This_Item;
  139.         End Else Begin
  140.             This_Item^.Next:=Newsitem(Sdrive,Nil);
  141.             This_Item:=This_Item^.Next;
  142.         End;
  143.     End;
  144.     Drives_View:= New(Pradiobuttons, Init(Rs,First_Item));
  145.     Insert(Drives_View);
  146.     Rs.Assign(13, 3, 23, 4);
  147.     Insert(New(Plabel, Init(Rs, '~U~nidades ', Drives_View)));
  148.     Rs.Assign(12, 10, 22, 12);
  149.     Insert(New(Pbutton, Init(Rs, '~O~k', Cmok, Bfdefault)));
  150.     Rs.Assign(25, 10, 37, 12);
  151.     Insert(New(Pbutton, Init(Rs, '~C~ancelar', Cmcancel, Bfnormal)));
  152.     Setdata(Data);
  153.   End;
  154.   Chgdialog^.Selectnext(False);
  155.   Wresult := Desktop^.Execview(Chgdialog);
  156.   If Wresult <> Cmcancel Then Begin
  157.     Chgdialog^.Getdata(Data);
  158.     Bdrive:=Lo(Data.Wdrive);
  159.         Select_Drive:=0;
  160.   End Else
  161.       Select_Drive:=Wresult;
  162.   Dispose(Chgdialog, Done);
  163. End;
  164.  
  165. Function Tmyapp.Change_Drive:Word;
  166.  
  167. Var Bswap:Byte;
  168.     Wresult:Word;
  169.  
  170. Label Salida;
  171.  
  172. Begin
  173.      Bswap:=Bdrive;
  174.      Wresult:=Select_Drive;
  175.      If Wresult=Cmcancel Then
  176.         Bdrive:=Bswap;
  177.      Change_Drive:=Wresult;
  178. End;
  179.  
  180. { Para su uso con OS/2 }
  181. Procedure Tmyapp.Change_Window(Sname:String);
  182. Var R:Registers;
  183. Begin
  184.      R.Ah:=$64;
  185.      R.Dx:=$0001;
  186.      R.Cx:=$636C;
  187.      R.Bx:=0;
  188.      R.Es:=Seg(Sname[1]);
  189.      R.Di:=Ofs(Sname[1]);
  190.      Msdos(R);
  191. End;
  192.  
  193. Function Find_Exe_Name: Pathstr;
  194. Var
  195.   Sexename: Pathstr;
  196.   Sdir: Dirstr;
  197.   Sname: Namestr;
  198.   Sext: Extstr;
  199. Begin
  200.   Sexename := Paramstr(0);
  201.   If Sexename='' Then
  202.      Sexename := Fsearch('MDISKPRO.EXE',Getenv('PATH'));
  203.   Fsplit(Sexename, Sdir, Sname, Sext);
  204.   If Length(Sdir)>0 Then
  205.   If Sdir[Length(Sdir)]<>'\' Then Sdir:=Sdir+'\';
  206.   Find_Exe_Name := Sdir;
  207. End;
  208.  
  209. Procedure Tmyapp.Writehelp;
  210. Begin
  211.      Writeln(' MDISKPRO [X:] [/XXX] [/Fnombre] [/FCnombre] [/H|/?]');
  212.      Writeln;
  213.      Writeln('   X:          Unidad de disquete que se va a utilizar para la copia.');
  214.      Writeln('   /Fnombre    Nombre del archivo imagen del disquete a crear.');
  215.      Writeln('               Sin especificar ruta: /fnoname.dat.');
  216.      Writeln('   /FCnombre   Nombre del archivo imagen del disquete a utilizar.');
  217.      Writeln('               Sin especificar ruta: /fcnoname.dat.');
  218.      Writeln('   /XXX        Número de copias del disquete.');
  219.      Writeln('   /H o /?     Imprime esta pantalla de ayuda.');
  220.      Halt;
  221. End;
  222.  
  223. Constructor Tmyapp.Init;
  224. Var Bloop,Bloop2:Byte;
  225.     Spar:String;
  226.     Icode:Integer;
  227.     Ev:Tevent;
  228. Begin
  229.      Writeln(Scopyright);
  230.      If (Paramcount>0) And ((Paramstr(1)='/?') Or (Paramstr(1)='/H')) Then
  231.         Writehelp;
  232.      Registerhelpfile;
  233.      Swhere:=Find_Exe_Name;
  234.      Screenmode:=Smco80;
  235.      Tapplication.Init;
  236.      Lee_Opciones(Swhere+'MDISK.INI');
  237.      Inicializar_Fuentes;
  238.      If Not(Comprueba_Codigo(Scopyright,6322)) Then Activa_Proteccion;
  239.      If Lo(Dosversion)>=20 Then Change_Window('MDISK OS/2'#0);
  240.      Wflags:=0;
  241.      If Opciones_Programa.Verificar=1 Then
  242.          Wflags:=Wflags Or Fpverify;
  243.      Bdrive:=Byte(Opciones_Programa.Unidad);
  244.      For Bloop:=1 To Paramcount Do Begin
  245.          Spar:=Paramstr(Bloop);
  246.          For Bloop2:=1 To Length(Spar) Do Spar[Bloop2]:=Upcase(Spar[Bloop2]);
  247.          If (Spar[1]='/') And (Spar<>'/V') Then
  248.              Val(Copy(Spar,2,Length(Spar)),Icopies,Icode);
  249.          If (Length(Spar)=2) And (Spar[2]=':')
  250.             And (Spar[1] In ['A'..'Z']) Then Bdrive:=Ord(Spar[1])-65;
  251.          If Spar='/V' Then Wflags:=Wflags Or Fpverify;
  252.          If (Copy(Spar,1,2)='/F') Then Begin
  253.             Sfile:=Copy(Spar,3,Length(Spar));
  254.             Wflags:=Wflags Or Fptofile;
  255.          End;
  256.          If (Copy(Spar,1,3)='/FC') Then Begin
  257.             Sfile:=Copy(Spar,4,Length(Spar));
  258.             Wflags:=Wflags Or Fpfromfile;
  259.          End;
  260.      End;
  261.      If Icode<>0 Then Val(Opciones_Programa.Copias,Icopies,Icode);
  262.      If (Paramcount>0) And (Bdrive<>255) Then Begin
  263.         Ev.What:=Evcommand;
  264.         Ev.Command:=Cmcopy;
  265.         Putevent(Ev);
  266.      End;
  267. End;
  268.  
  269. Destructor Tmyapp.Done;
  270. Begin
  271.      If Lo(Dosversion)>=20 Then Change_Window(''#0);
  272.      If Modif_Op Then Begin
  273.         Modif_Op:=False;
  274.         Escribe_Opciones(Swhere+'MDISK.INI');
  275.      End;
  276.      Setvideomode(Startupmode);
  277.      Tapplication.Done;
  278. End;
  279.  
  280. Procedure Tmyapp.Getevent(Var Event: Tevent);
  281. Var
  282.   W: Pwindow;
  283.   Hfile: Phelpfile;
  284.   Helpstrm: Pdosstream;
  285. Const
  286.   Helpinuse: Boolean = False;
  287. Begin
  288.   Tapplication.Getevent(Event);
  289.   Case Event.What Of
  290.     Evcommand:
  291.       If (Event.Command = Cmhelp) And Not Helpinuse Then
  292.       Begin
  293.         Helpinuse := True;
  294.         Helpstrm := New(Pdosstream, Init(Swhere+'MDISK.HLP', Stopenread));
  295.         Hfile := New(Phelpfile, Init(Helpstrm));
  296.         If Helpstrm^.Status <> Stok Then
  297.         Begin
  298.           Messagebox('No pude abrir MDISK.HLP.', Nil, Mferror + Mfokbutton);
  299.           Dispose(Hfile, Done);
  300.         End
  301.         Else
  302.         Begin
  303.           W := New(Phelpwindow,Init(Hfile, Gethelpctx));
  304.           If Validview(W) <> Nil Then
  305.           Begin
  306.             Execview(W);
  307.             Dispose(W, Done);
  308.           End;
  309.           Clearevent(Event);
  310.         End;
  311.         Helpinuse := False;
  312.       End;
  313.   End;
  314. End;
  315.  
  316. Function Tmyapp.Getpalette: Ppalette;
  317. Const
  318.   Cnewcolor = Ccolor + Chelpcolor;
  319.   Cnewblackwhite = Cblackwhite + Chelpblackwhite;
  320.   Cnewmonochrome = Cmonochrome + Chelpmonochrome;
  321.   P: Array[Apcolor..Apmonochrome] Of String[Length(Cnewcolor)] =
  322.     (Cnewcolor, Cnewblackwhite, Cnewmonochrome);
  323. Begin
  324.   Getpalette := @P[Apppalette];
  325. End;
  326.  
  327. Procedure Tmyapp.Outofmemory;
  328. Begin
  329.   Messagebox('Memoria insuficiente para esta operación.',
  330.     Nil, Mferror + Mfokbutton);
  331.     Done;
  332.     Exit;
  333. End;
  334.  
  335. Procedure Tmyapp.Handleevent(Var Event: Tevent);
  336.     Begin
  337.         Tapplication.Handleevent(Event);
  338.         If (Event.What=Evcommand) Then
  339.            Case Event.Command Of
  340.                 Cmsandc:
  341.                    If Change_Drive<>Cmcancel Then
  342.                       Copy_Disk(Bdrive,Icopies,Wflags,Sfile);
  343.                 Cmcopy:Copy_Disk(Bdrive,Icopies,Wflags,Sfile);
  344.                 Cmopt:Muestra_Opciones;
  345.                 Else Exit;
  346.            End;
  347.         Clearevent(Event);
  348.     End;
  349.  
  350. Procedure Tmyapp.Initmenubar;
  351. Var R:Trect;
  352.     Pt:Pstatictext;
  353.     Sline:String;
  354. Begin
  355.      Getextent(R);
  356.      R.B.Y := R.A.Y + 1;
  357.      Sline:=Scopyright+' ['+Swhere+']';
  358.      Pt:=New(Pstatictext,Init(R,Sline));
  359.      Insert(Pt);
  360.      Inc(R.A.Y);Inc(R.B.Y);
  361.      Menubar := New(Pmenubar, Init(R, Newmenu(
  362.      Newsubmenu('~D~iscos ',Hcnocontext, Newmenu(
  363.       Newitem('~C~opiar', 'Alt-C', Kbaltc, Cmsandc,Hccdisco,
  364.       Newitem('~O~pciones ...', 'Alt-O', Kbalto, Cmopt,Hcopciones,
  365.       Newitem('~S~alir', 'Alt-X',Kbaltx, Cmquit,Hcsalir,
  366.       Nil)))),Nil))));
  367. End;
  368.  
  369. Procedure Tmyapp.Initstatusline;
  370. Var R:Trect;
  371. Begin
  372.   Getextent(R);
  373.   R.A.Y := R.B.Y - 1;
  374.   Statusline := New(Pstatusline, Init(R,
  375.     Newstatusdef(0, $Ffff,
  376.       Newstatuskey('', Kbf10, Cmmenu,
  377.       Newstatuskey('~F1~ Ayuda', Kbf1, Cmhelp,
  378.       Newstatuskey('~Alt-X~ Salir', Kbaltx, Cmquit,
  379.       Newstatuskey('~Esc~ Interrumpir acción', Kbnokey,Cmnothing,
  380.       Nil)))),
  381.     Nil)
  382.   ));
  383. End;
  384.  
  385. Var Myapp:Tmyapp;
  386.  
  387. Begin
  388.     Myapp.Init;
  389.     Myapp.Run;
  390.     Myapp.Done;
  391. End.
  392.